home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / madtrb40.zip / ANSWER.INC next >
Text File  |  1986-01-21  |  6KB  |  139 lines
  1. Procedure Parse(Var Line : Str255; Var Word : Str80; Delim : Char);
  2. {Removes first word in Line and returns it in Word.  Line is modified so that
  3.  it no longer has leading blanks before the word is filled.  The delim constant
  4.  is used to identify the symbol used to delimit words.  The Line variable is
  5.  decreased in length by one word, and of course leading blanks, before it is
  6.  returned}
  7. Const
  8.   Space  =  ' ';
  9. Var
  10.   Indx, Len  :  Integer;
  11. Begin
  12.   While Pos(Space, Line) = 1 Do     {remove leading blanks}
  13.     Delete(Line, 1, 1);
  14.   Len := Pos(Delim, Line);
  15.   If Len = 0 then
  16.     begin             {no delimiters left}
  17.       Word := Line;
  18.       Line := '';
  19.     End
  20.   Else If Len = 1 then
  21.       begin                             {check for two delimiters in a row}
  22.         Word := '';                      {return null string}
  23.         Delete(Line, 1, Len);            {delete delimiter}
  24.       End
  25.     Else
  26.       Begin                             {get word and delete from line}
  27.         Word := Copy(Line, 1, Len -1);  {get all but delimiter}
  28.         Delete(Line, 1, Len);            {delete word plus delimeter}
  29.       End
  30. End;  {of Parse}
  31.  
  32. Procedure LowToUp(Var Line : Str255);
  33. {Converts characters in Line to upper case}
  34. Var
  35.   Indx, Len      : Integer;
  36. Begin
  37.   Len := Length(Line);
  38.   For Indx := 1 to Len do
  39.     Line[Indx] := UpCase(Line[Indx]);   {built-in TURBO function}
  40. End;  {of LowToUp}
  41.  
  42. Procedure Answer(Ans : Str255; Var Posn : Integer; CaseSen : Boolean);
  43. {Answer will motitor the keyboard and only allow entry of one of the possible
  44.  matches found in Str255.  Responses in Ans should be separated by a comma
  45.  and may be padded with blanks, although all leading blanks will be ignored
  46.  when processing a response.  When enough keystrokes have been entered to
  47.  identify a match as being unique, the rest of the response is displayed and
  48.  the user can accept the answer by hitting return or can strike the backspace
  49.  key and re-enter another valid response.  The procedure returns the ordinal
  50.  position of the response to the calling program for further processing.
  51.  CaseSen is used to determine is the response should be upper/lower case
  52.  sensitive.}
  53. Label
  54.   Return, Start;
  55. Var
  56.   Indx           :  Integer;    {number of possible answers}
  57.   ChPos          :  Integer;    {Chacter position index}
  58.   Cnt            :  Integer;    {counter for correct matches}
  59.   Match          :  Array[1..25] of Str80;       {possible answer array}
  60.   Mtch           :  Array[1..25] of Boolean;        {Previous match array}
  61.   StrPos         :  Integer;           {index for stepping through matches}
  62.   Ch             :  Char;              {variable read from the keyboard}
  63.   MtchLen        :  Integer;           {contains the length of the match}
  64.   I              :  Integer;           {counter index}
  65. Begin
  66.   Indx := 0;
  67.   If NOT CaseSen then               {Check upper/lower case sensitivity}
  68.   LowToUp(Ans);                     {If not sensitive then capitalize all ans.}
  69.   While Ans <> '' do                {Parse Ans into matching responses}
  70.     Begin
  71.       Indx := Indx +  1;               {find number of answers}
  72.       Parse(Ans,Match[Indx],',');      {and put them in Match[array]}
  73.     End;
  74.   If Indx = 0 then                 {Check to see if a string was passed in Ans}
  75.     Begin
  76.       Write('No string was passed to use as a response, please check code.');
  77.       Goto Return;
  78.     End;
  79. Start:
  80.   For Cnt := 1 to 25 do Mtch[Cnt] := True; {Initialize pointers to all true}
  81.   ChPos := 1;
  82.   Repeat
  83.     Cnt := 0;                             {set match counter}
  84.     Read(Kbd, Ch);                        {Get characters from the keyboard}
  85.     If NOT CaseSen then Ch := UpCase(Ch);
  86.       For StrPos := 1 to Indx do          {Search all responses for matches}
  87.         Begin
  88.           If Mtch[StrPos] then            {Check for previous match}
  89.             If Ch = Copy(Match[StrPos], ChPos, 1) then
  90.               Begin
  91.                 Cnt  := Cnt + 1;             {Count the number of matches}
  92.                 Posn := StrPos;              {Enter the position of the last}
  93.               End                           {match in the return variable.}
  94.         End;
  95.     If Cnt = 0 then             {Check for no match}
  96.       If Ch = Chr(8) then          {Check for a backspace}
  97.         Begin                   {If backspace has been hit then decrease}
  98.           ChPos := ChPos -1;    {the character index by one.}
  99.           If ChPos < 1 then     {If the backspace has been over used then}
  100.             Begin               {reset to position one and beep.}
  101.               ChPos := 1;
  102.               Write(Chr(7));
  103.             End
  104.           Else
  105.             Begin
  106.               Write(Chr(8));
  107.               Write(Chr(32));
  108.               Write(Chr(8));
  109.             End;
  110.         End
  111.       Else
  112.         Write(Chr(7))      {If the character has no match just beep and}
  113.     Else                        {don't write it to the screen}
  114.       Begin
  115.         For StrPos := 1 to Indx do
  116.           If Ch <> Copy(Match[StrPos], ChPos, 1) then
  117.             Mtch[StrPos] := False;
  118.         ChPos := ChPos + 1;
  119.         Write(Ch);           {Otherwise write the matching character to the}
  120.       End;
  121.   Until Cnt = 1;                 {screen.}
  122.   MtchLen := Length(Match[Posn]) - ChPos + 1;
  123.   Write(Copy(Match[Posn], ChPos, MtchLen));
  124.   Repeat
  125.    Read(Kbd, Ch);
  126.    If Ch = Chr(8) then
  127.     begin
  128.      For I := 1 to Length(Match[Posn]) do Write(Chr(8));
  129.      For I := 1 to Length(Match[Posn]) do Write(Chr(32));
  130.      For I := 1 to Length(Match[Posn]) do Write(Chr(8));
  131.      ChPos := 1;
  132.      Goto Start;
  133.     end
  134.    else
  135.     If Ord(Ch) <> 13 then Write (Chr(7));
  136.   Until Ord(Ch) = 13;
  137. Return:
  138. End;  {of Answer}
  139.